home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Modules / namespaces.em < prev    next >
Encoding:
Text File  |  1992-10-06  |  1.3 KB  |  61 lines
  1. (defmodule namespaces (standard0) ()
  2.  
  3.   ;
  4.   ;; Structure
  5.   ;
  6.  
  7.   (defstruct name-space ()
  8.     ((binding-table 
  9.        initform (make-table eq)
  10.        reader name-space-binding-table))
  11.     constructor make-name-space)
  12.  
  13.   (export name-space make-name-space)
  14.  
  15.   ;
  16.   ;; Functionality
  17.   ;
  18.  
  19.   (defgeneric name-space-ref (space name))
  20.  
  21.   (defgeneric set-name-space-ref (space name value))
  22.  
  23.   ((setter setter) name-space-ref set-name-space-ref)
  24.  
  25.   (export name-space-ref)
  26.  
  27.   ;
  28.   ;; Default methods
  29.   ;
  30.  
  31.   (defmethod name-space-ref ((space name-space) (name symbol))
  32.     (table-ref (name-space-binding-table space) name))
  33.  
  34.   (defmethod (setter name-space-ref) ((space name-space) (name symbol) val)
  35.     ((setter table-ref) (name-space-binding-table space) name val))
  36.  
  37.   ;
  38.   ;; Syntax
  39.   ;
  40.  
  41.   (defmacro def-name-space (name)
  42.     `(defconstant ,name (make-name-space)))
  43.  
  44.   (defmacro export-to-name-space (space . key-list)
  45.     (labels
  46.       ((map-key-list (fn kl)
  47.      (cond ((null kl) ()) 
  48.            ((null (cdr kl)) ()) ; Should signal an error
  49.            (t (cons (fn (car kl) (car (cdr kl))) 
  50.             (map-key-list fn (cdr (cdr kl))))))))
  51.       `(progn
  52.      ,@(map-key-list
  53.          (lambda (key val)
  54.            `((setter name-space-ref) ,space ',key ,val))
  55.          key-list))))
  56.  
  57.   (export def-name-space export-to-name-space)
  58.  
  59. )
  60.  
  61.